home *** CD-ROM | disk | FTP | other *** search
/ Amiga Collections: Auge 4000 / Auge 4000 #44 (1990-05-04)(Amiga User Gruppe Einzugsgebiet 4000).zip / Auge 4000 #44 (1990-05-04)(Amiga User Gruppe Einzugsgebiet 4000).adf / Unterhaltung / Zocker / Berliner Macke (.txt) < prev    next >
AmigaBASIC Source Code  |  1990-05-01  |  10KB  |  414 lines
  1. REM ********************
  2. REM *                  *
  3. REM *  Berliner Macke  *
  4. REM *                  *
  5. REM *    AmigaBASIC    *
  6. REM *                  *
  7. REM ********************
  8. CLEAR ,30000
  9. OPTION BASE 1
  10. DIM Vorname$(8),p(8),w(6),w1(6),v(10),v1(6),n(6)
  11. RANDOMIZE TIMER
  12. SCREEN 2,320,250,5,1
  13. WINDOW 2,"",,16,2
  14. OPEN"Wuerfel1" FOR INPUT AS 1
  15. Eins$=INPUT$(LOF(1),1):OBJECT.SHAPE 1,Eins$:CLOSE 1
  16. OPEN"Wuerfel2" FOR INPUT AS 1
  17. Zwei$=INPUT$(LOF(1),1):OBJECT.SHAPE 2,Zwei$:CLOSE 1
  18. OPEN"Wuerfel3" FOR INPUT AS 1
  19. Drei$=INPUT$(LOF(1),1):OBJECT.SHAPE 3,Drei$:CLOSE 1
  20. OPEN"Wuerfel4" FOR INPUT AS 1
  21. Vier$=INPUT$(LOF(1),1):OBJECT.SHAPE 4,Vier$:CLOSE 1
  22. OPEN"Wuerfel5" FOR INPUT AS 1
  23. Fuenf$=INPUT$(LOF(1),1):OBJECT.SHAPE 5,Fuenf$:CLOSE 1
  24. OPEN"Wuerfel6" FOR INPUT AS 1
  25. Sechs$=INPUT$(LOF(1),1):OBJECT.SHAPE 6,Sechs$:CLOSE 1
  26. OPEN"Pfeil" FOR INPUT AS 1
  27. Pfeil$=INPUT$(LOF(1),1):OBJECT.SHAPE 7,Pfeil$:CLOSE 1
  28. Anfang:
  29. COLOR 0,6:CLS  
  30. GOSUB Macke
  31. COLOR 2,6:LOCATE 5,2:PRINT"SPIELERANZAHL (2-8):":a=2
  32. LOCATE 5,23:PRINT USING"#";a
  33. Abfrage:
  34. ta$=INKEY$:IF ta$=CHR$(13) THEN Weiter
  35. IF ta$=CHR$(32) THEN CALL Pause:a=a+1
  36. IF a>8 THEN a=2
  37. IF ta$=CHR$(32) THEN SOUND 110*a,2,255:LOCATE 5,23:PRINT USING"#";a
  38. GOTO Abfrage
  39. Weiter:
  40. LOCATE 8,2:PRINT"DER COMPUTER WILL SIE GERNE BESIEGEN."
  41. LOCATE 10,2:PRINT"SEIN NAME: <Comp>"
  42. LOCATE 13,12:PRINT"DIE SPIELERNAMEN:"
  43. m2=1:j=1:FOR i=1 TO a
  44. LOCATE 13+i*2,2:PRINT"SPIELER"+STR$(i):LOCATE 13+i*2,11:INPUT Vorname$(i)
  45. IF Vorname$(i)<>"Comp" THEN Weiter1
  46. Vorname$(i)="Computer"+STR$(j):j=j+1
  47. Weiter1:
  48. NEXT i:CLS
  49. COLOR 0,6:FOR i=16 TO 25:COLOR 0,5:LOCATE i,4:PRINT SPACE$(14):COLOR 0,4:LOCATE i,23:PRINT SPACE$(14):NEXT i
  50. COLOR 1,4:LOCATE 29,4:PRINT"  PD-SOFTWARE VON A.U.G.E. 4000  "
  51. Schleife:
  52. FOR j=1 TO a:CALL Null(w()):OBJECT.CLOSE
  53. g=0:u2=0
  54. COLOR 0,6:LOCATE 2,1:PRINT SPACE$(39):GOSUB Macke
  55. COLOR 1,2:FOR wid=1 TO a+2:LOCATE 3+wid,1:PRINT SPACE$(39):NEXT wid
  56. LOCATE 4,8:PRINT"SPIELER:":LOCATE 4,26:PRINT"PUNKTE:"
  57. FOR i=1 TO a
  58. LOCATE 5+i,8:PRINT LEFT$(Vorname$(i),12)
  59. LOCATE 5+i,27:PRINT USING"#####";p(i)
  60. NEXT i
  61. LOCATE 5+j,7:PRINT">":LOCATE 5+j,20:PRINT"<"
  62. LOCATE 5+j,26:PRINT">":LOCATE 5+j,32:PRINT"<"
  63. LOCATE 5+m2,24:PRINT"=>":LOCATE 5+m2,33:PRINT"<="
  64. IF MID$(Vorname$(j),1,4)="Comp" THEN CompZug
  65. Spielerzug:
  66. SOUND 880,2,255
  67. Taste:
  68. ta$=INKEY$:FOR j2=1 TO 25:NEXT j2
  69. Zurueck1:
  70. COLOR 1,2:LOCATE 27,4:PRINT Vorname$(j)+" (W)ÜRFELN!"
  71. COLOR 1,6:LOCATE 27,37:PRINT"   "
  72. FOR j2=1 TO 50:NEXT j2
  73. COLOR 0,2:LOCATE 27,4:PRINT SPACE$(33)
  74. IF ta$<>"w" THEN Taste
  75. GOSUB Wuerfeln
  76. IF z=0 THEN GOSUB Feststellung3:GOTO Fortsetzung
  77. IF z>6 THEN GOSUB Jump:GOSUB Anzeige2:GOTO Entscheidung
  78. Zurueck2:
  79. COLOR 1,2:LOCATE 27,4:PRINT"PFEILE + >RETURN<,     (E)NDE"
  80. COLOR 1,6:LOCATE 27,37:PRINT"   "
  81. FOR i=1 TO 6:IF w(i)=10 THEN Naechste4
  82. IF v(w(i))>0 THEN Pfeil
  83. Naechste4:
  84. NEXT i
  85. Pfeil:
  86. OBJECT.SHAPE 7,Pfeil$
  87. GOSUB Koordinaten
  88. OBJECT.X 7,c(i):OBJECT.Y 7,b(i):OBJECT.ON 7
  89. GOSUB Bewegen:GOSUB Anzeige2
  90. IF z>0 OR ta$="e" THEN ETaste
  91. Entscheidung:
  92. ta$=INKEY$:FOR j2=1 TO 20:NEXT j2
  93. COLOR 1,2:LOCATE 27,4:PRINT"(W)ÜRFELN  (E)NDE"+SPACE$(10)
  94. COLOR 1,6:LOCATE 27,37:PRINT"   "
  95. IF ta$="w" THEN WTaste
  96. IF ta$="e" THEN ETaste2
  97. COLOR 1,2:LOCATE 27,4:PRINT SPACE$(33)
  98. GOTO Entscheidung
  99. ETaste:
  100. IF ta$="e" THEN Anzeige3
  101. Entscheidung2:
  102. ta$=INKEY$:FOR j2=1 TO 20:NEXT j2
  103. COLOR 1,2:LOCATE 27,4:PRINT"(S)ETZEN  (W)ÜRFELN  (E)NDE"
  104. COLOR 1,6:LOCATE 27,37:PRINT"   "
  105. IF ta$="s" THEN Zurueck2
  106. WTaste:
  107. IF ta$="w" THEN GOSUB Loeschen:GOTO Zurueck1
  108. ETaste2:
  109. IF ta$="e" THEN GOSUB Gueltig:GOTO Anzeige3
  110. COLOR 1,2:LOCATE 27,4:PRINT SPACE$(33)
  111. GOTO Entscheidung2
  112. Anzeige3:
  113. u2=u2+u1
  114. p(j)=p(j)+u2:COLOR 1,2:LOCATE 5+j,27:PRINT USING"#####";p(j)
  115. m=0:FOR i=1 TO a:IF p(i)>m THEN m1=m:m=p(i):m2=i
  116. NEXT i
  117. m1=0:FOR i=1 TO a:IF i=m2 OR p(i)<m1 THEN Naechste9
  118. IF i<>m2 OR p(i)>=m1 THEN m1=p(i)
  119. Naechste9:
  120. NEXT i
  121. OBJECT.CLOSE
  122. FOR i=1 TO 4
  123. SOUND 880,1,255:COLOR 1,2:LOCATE 5+m2,24:PRINT"  ":LOCATE 5+m2,33:PRINT"<="
  124. FOR verz=1 TO 3:CALL Pause:NEXT verz
  125. SOUND 880,1,255:LOCATE 5+m2,24:PRINT"=>":LOCATE 5+m2,33:PRINT"  "
  126. FOR verz=1 TO 3:CALL Pause:NEXT verz
  127. NEXT i
  128. LOCATE 5+m2,33:PRINT"<="
  129. SOUND 830,5,255:SOUND 1108,5,255
  130. Fortsetzung:
  131. NEXT j
  132. IF m<10000 THEN Schleife
  133. FOR aa=1 TO 3000:NEXT aa
  134. OBJECT.CLOSE
  135. COLOR 0,6:CLS:GOSUB Macke
  136. COLOR 2,6:LOCATE 4,15:PRINT"SPIELENDE"
  137. FOR i=1 TO 7:FOR j=i+1 TO a
  138. IF p(i)>=p(j) THEN Naechste11
  139. m=p(i):a$=Vorname$(i):p(i)=p(j)
  140. Vorname$(i)=Vorname$(j):p(j)=m:Vorname$(j)=a$
  141. Naechste11:
  142. NEXT j:NEXT i
  143. LOCATE 7,11:PRINT"DIE SIEGERLISTE:"
  144. FOR i=1 TO a
  145. LOCATE 8+2*i,7:PRINT STR$(i)+". "+LEFT$(Vorname$(i),12):LOCATE 8+2*i,24:PRINT USING"#####";p(i)
  146. NEXT i
  147. LOCATE 28,10:PRINT"NEUES SPIEL (J/N) ?"
  148. Tasten:
  149. ta$=INKEY$
  150. IF ta$="j" THEN GOSUB Nullen:GOTO Anfang
  151. IF ta$="n" THEN COLOR 1,2:CLS:LOCATE 15,10:PRINT"BIS ZUM NÄCHSTEN MAL!":END
  152. GOTO Tasten 
  153. CompZug:
  154. u2=0
  155. Display1:
  156. SOUND 990,3,255:COLOR 1,2
  157. LOCATE 27,4:PRINT Vorname$(j)+" WÜRFELT"+SPACE$(15)
  158. COLOR 1,6:LOCATE 27,37:PRINT"   "
  159. CALL Null(n()):GOSUB Wuerfeln
  160. IF z=0 THEN GOSUB Feststellung3:GOTO Fortsetzung
  161. IF z>5 THEN GOSUB Jump:u3=u+u2:GOSUB Stoppen:ON f GOTO Display,Loeschen3
  162. GOSUB Setzt
  163. Zurueck3:
  164. k=-10:FOR i=1 TO 6
  165. IF v(i)=0 THEN Naechste10
  166. IF INT(n(i)/v(i)+0.5)<=k THEN Naechste10
  167. k=n(i):l=i
  168. Naechste10:
  169. NEXT i
  170. FOR i=1 TO 6:IF w(i)=l THEN Gleiten1
  171. NEXT i
  172. Gleiten1:
  173. GOSUB Gleiten
  174. CALL Null(n()):IF z=0 THEN Addition
  175. r=10:GOSUB ZufEntscheidung
  176. IF f=1 THEN Addition
  177. CALL Null(v()):CALL Wert(v(),w(),u,z,n()):GOTO Zurueck3
  178. Addition:
  179. u3=u2+u1:GOSUB Stoppen
  180. ON f GOTO Gueltig1,Loeschen3
  181. Loeschen3:
  182. GOSUB Loeschen:GOTO Display1
  183. Gueltig1:
  184. GOSUB Gueltig
  185. Display:
  186. GOSUB Anzeige2
  187. SOUND 990,3,255:COLOR 1,2:LOCATE 27,4:PRINT Vorname$(j)+" HÖRT AUF"+SPACE$(14)
  188. COLOR 1,6:LOCATE 27,37:PRINT"   "
  189. GOTO Anzeige3
  190. Nullen:
  191. FOR i=1 TO 8:p(i)=0:NEXT i
  192. RETURN
  193. Macke:
  194. COLOR 2,5
  195. FOR i=1 TO 20:FOR j1=1 TO 30:NEXT j1
  196. SOUND 270+10*i,1.5,255
  197. LOCATE 2,41-2*i:PRINT" * * * * * * BERLINER MACKE * * * * * *"
  198. NEXT i
  199. RETURN
  200. Wuerfeln:
  201. CALL Null(w1())
  202. FOR i=1 TO 6
  203. IF w(i)=10 THEN Naechste
  204. w(i)=INT(RND*6)+1
  205. IF w(i)=1 THEN Sprite$(i)=Eins$
  206. IF w(i)=2 THEN Sprite$(i)=Zwei$
  207. IF w(i)=3 THEN Sprite$(i)=Drei$
  208. IF w(i)=4 THEN Sprite$(i)=Vier$
  209. IF w(i)=5 THEN Sprite$(i)=Fuenf$
  210. IF w(i)=6 THEN Sprite$(i)=Sechs$
  211. Naechste:
  212. NEXT i
  213. COLOR 1,2:LOCATE 15,4:PRINT"WURF:":LOCATE 15,23:PRINT"SUMME:"
  214. LOCATE 15,29:PRINT USING"#####";u2
  215. FOR i=1 TO 6
  216. IF w(i)=10 THEN Naechste1
  217. SOUND 180*i,2,255
  218. OBJECT.SHAPE i,Sprite$(i)
  219. GOSUB Koordinaten
  220. OBJECT.X i,c(i)
  221. OBJECT.Y i,b(i)
  222. OBJECT.ON i
  223. Naechste1:
  224. NEXT i
  225. IF g>0 THEN Werte 
  226. IF g<1 THEN GOSUB Feststellung1
  227. IF z=10 THEN Anzeige
  228. Werte:
  229. CALL Null(v())
  230. CALL Wert(v(),w(),u,z,n())
  231. IF z+g=6 THEN z=20:GOSUB Feststellung2
  232. Anzeige:
  233. COLOR 1,2:LOCATE 15,9:PRINT USING"#####";u
  234. RETURN
  235. Anzeige2:
  236. COLOR 1,2:LOCATE 15,29:PRINT USING"#####";u2+u1
  237. RETURN
  238. Setzt:
  239. SOUND 990,3,255:COLOR 1,2:LOCATE 27,4:PRINT Vorname$(j)+" SETZT"+SPACE$(17)
  240. COLOR 1,6:LOCATE 27,37:PRINT"   "
  241. RETURN 
  242. ZufEntscheidung:
  243. IF INT(RND*100)+1<=r THEN f=2
  244. IF INT(RND*100)+1>r THEN f=1
  245. RETURN
  246. Stoppen:
  247. k=p(j)+u3:IF k<m THEN Ermittlung
  248. IF p(j)<m THEN m1=m
  249. GOTO Ermittlung2
  250. Ermittlung:
  251. GOSUB Werte3
  252. r=(7-g)*15+8-(10000-wt3)/1000-u3/100+(m-k)/1000
  253. GOTO Ermittlung3
  254. IF k>=10000 THEN r=0:RETURN
  255. Ermittlung2:
  256. r=(6-g)*15+(10000-k)/2000-u3/80+10-(k-m1)/1000
  257. Ermittlung3:
  258. GOSUB Werte4
  259. GOSUB ZufEntscheidung
  260. RETURN
  261. Koordinaten:
  262. b(i)=(16+INT((i-1)/3)*4)*8
  263. c(i)=(-0.9+3.2*i-INT((i-1)/3)*8)*10
  264. RETURN
  265. Feststellung1:
  266. FOR i=1 TO 5:FOR k=i+1 TO 6
  267. IF w(i)=w(k) THEN RETURN
  268. NEXT k:NEXT i
  269. u=1000:u1=1000:z=10
  270. COLOR 1,2:FOR i=1 TO 14:SOUND i*500,1.5,255
  271. LOCATE 27,32-i*2:PRINT"STRASSE"+SPACE$(26)
  272. NEXT i:COLOR 1,6:LOCATE 27,37:PRINT "   ":FOR j3=1 TO 1500:NEXT j3
  273. RETURN
  274. Feststellung2:
  275. COLOR 1,2:FOR i=1 TO 14:SOUND i*300,1.5,255
  276. LOCATE 27,32-i*2:PRINT"ALLE WÜRFEL GELTEN!"+SPACE$(14)
  277. NEXT i:COLOR 1,6:LOCATE 27,37:PRINT"   ":u1=u:FOR j3=1 TO 1500:NEXT j3
  278. RETURN 
  279. Feststellung3:
  280. COLOR 0,6:LOCATE 2,1:PRINT SPACE$(39):GOSUB Macke
  281. COLOR 1,2:FOR i=1 TO 14:SOUND i*400,1.5,255
  282. LOCATE 27,32-i*2:PRINT"LEIDER GAR NICHTS!"+SPACE$(15)
  283. NEXT i:COLOR 1,6:LOCATE 27,37:PRINT"   ":FOR j3=1 TO 1500:NEXT j3
  284. RETURN
  285. Jump:
  286. FOR i=1 TO 6
  287. IF w(i)=10 THEN Naechste5
  288. OBJECT.SHAPE 7,Pfeil$
  289. GOSUB Koordinaten
  290. OBJECT.X 7,c(i):OBJECT.Y 7,b(i):OBJECT.ON 7
  291. SOUND 1100,2,255
  292. OBJECT.X i,c(i)+152:OBJECT.Y i,b(i)
  293. w1(i)=w(i)
  294. Naechste5:
  295. NEXT i
  296. g=0:z=0:CALL Null(w()):OBJECT.CLOSE 7
  297. GOSUB Anzeige2
  298. RETURN
  299. Loeschen:
  300. u2=u2+u1
  301. FOR i=1 TO 6:IF w(i)=10 THEN Naechste6
  302. OBJECT.OFF i
  303. Naechste6:
  304. NEXT i
  305. RETURN
  306. Gueltig:
  307. IF z=0 THEN RETURN
  308. FOR i=1 TO 6
  309. IF w(i)>6 THEN Naechste7
  310. IF v(w(i))>0 THEN GOSUB Gleiten
  311. Naechste7:
  312. NEXT i
  313. RETURN
  314. Gleiten:
  315. OBJECT.SHAPE 7,Pfeil$
  316. GOSUB Koordinaten
  317. OBJECT.X 7,c(i):OBJECT.Y 7,b(i):OBJECT.ON 7
  318. CALL Move(i,b(i),c(i),w1(i),w(i),g,z,v())
  319. IF w1(i)=1 AND v(1)<2 THEN Loeschen2
  320. IF w1(i)=5 AND v(5)<2 THEN Loeschen2
  321. FOR l=1 TO 6
  322. IF w(l)<>w1(i) THEN Naechste8
  323. OBJECT.X 7,c(l):OBJECT.Y 7,b(l):OBJECT.ON 7
  324. CALL Move(l,b(l),c(l),w1(l),w(l),g,z,v())
  325. Naechste8:
  326. NEXT l
  327. Loeschen2:
  328. OBJECT.CLOSE 7:CALL Null(v1()):CALL Wert(v1(),w1(),u1,l,n())
  329. GOSUB Anzeige2
  330. RETURN
  331. Bewegen:
  332. SOUND 200,2,255
  333. Key:
  334. ta$=INKEY$
  335. IF ta$=CHR$(30) THEN GOSUB Werte1:GOTO Hinsetzen
  336. IF ta$=CHR$(31) THEN GOSUB Werte2:GOTO Hinsetzen
  337. IF ta$="e" THEN GOSUB Gueltig:RETURN
  338. IF ta$=CHR$(13) THEN Setzen
  339. GOTO Key
  340. Hinsetzen:
  341. OBJECT.SHAPE 7,Pfeil$
  342. GOSUB Koordinaten
  343. OBJECT.X 7,c(i):OBJECT.Y 7,b(i):OBJECT.ON 7
  344. GOTO Bewegen
  345. Setzen:
  346. OBJECT.SHAPE 7,Pfeil$
  347. GOSUB Koordinaten
  348. OBJECT.X 7,c(i):OBJECT.Y 7,b(i):OBJECT.ON 7
  349. COLLISION ON
  350. OBJECT.HIT 7,i,i
  351. k=COLLISION(i)
  352. IF k<>0 THEN Key
  353. IF v(w(i))=0 OR w(i)=10 THEN Key
  354. GOSUB Gleiten
  355. RETURN
  356. Werte1:
  357. IF (i+1)<=6 THEN i=(i+1)
  358. RETURN
  359. Werte2:
  360. IF (i-1)>=1 THEN i=(i-1)
  361. RETURN
  362. Werte3:
  363. IF m>1000 THEN m=wt3
  364. IF m<=1000 THEN wt3=1000
  365. RETURN
  366. Werte4:
  367. IF r<95 THEN wt4=r
  368. IF r>=95 THEN wt4=95
  369. IF wt4>5 THEN r=wt4
  370. IF wt4<=5 THEN r=5
  371. RETURN
  372. SUB Move(i,b,c,w1,w,g,z,v())STATIC
  373. SOUND 330,3,255
  374. FOR vx=c TO c+152 
  375. OBJECT.X i,vx:OBJECT.ON i
  376. NEXT vx
  377. SOUND 660,3,255
  378. v(w)=v(w)-1:w1=w:w=10:g=g+1:z=z-1
  379. END SUB
  380. SUB Wert(v(),w(),u,z,n())STATIC
  381. z=0:FOR i=1 TO 6
  382. IF w(i)=10 OR w(i)=0 THEN Naechste2
  383. v(w(i))=v(w(i))+1
  384. Naechste2:
  385. NEXT i:u=0
  386. IF v(1)>2 THEN u=1000+(v(1)-3)*1000 
  387. IF v(1)<=2 THEN u=v(1)*100
  388. n(1)=u:z=z+v(1)
  389. FOR i=2 TO 6
  390. IF i<>5 THEN Feststellung4
  391. z=z+v(5)
  392. IF v(5)>2 THEN Umrechnung1 
  393. IF v(5)<=2 THEN n(5)=v(5)*50:GOTO Umrechnung2
  394. Feststellung4:
  395. IF v(i)<3 THEN v(i)=0:GOTO Naechste3
  396. IF v(i)<3 THEN n(i)=0:GOTO Naechste3
  397. z=z+v(i)
  398. Umrechnung1:
  399. n(i)=i*100+(v(i)-3)*i*100
  400. Umrechnung2:
  401. u=u+n(i)
  402. Naechste3:
  403. NEXT i
  404. END SUB
  405. SUB Pause STATIC
  406. FOR wid=1 TO 300:NEXT wid
  407. END SUB
  408. SUB Null(v())STATIC
  409. FOR i=1 TO 6:v(i)=0:NEXT i
  410. END SUB
  411.  
  412.  
  413.  
  414.